perm filename MAISER.MID[D,MRC] blob sn#490447 filedate 1979-12-18 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00005 00003	CORBEG CMDPNT RPCBLK WINDOW DLIBUF OBUF MAICHN COREND
C00006 00004	MAISER
C00008 00005	GETCMD LOOP PRESC0 PRES1A PRESC1 PRESC2
C00011 00006	RUNCMD RUNCM1 RUNCM2 RUNCM3 BYECMD FLUSH
C00013 00007	MAICMD MAICM0 MAICM1
C00015 00008	MAICM2 MAIDST MAIDS1 MAICM3 MAINUL
C00017 00009	MAILOK MAILRD MSGSTR MSGCHR ..LIT
C00020 ENDMK
C⊗;
COMMENT ⊗
29-Jul-79  1525	BH  	compromise on validation 
The remind phantom will validate a recipient name if you mail to it,
so the server can start up a phantom, send it mail, and wait for a
response.  The name to be validated must be a regular name (prg,
human, or forwarding) and not a special form like @file or #file.
The name must be no more than 74 characters.  You send mail with
<20,,your job number> in word 0 followed by the asciz name starting
in word 1.  You get back mail with '[RMND]' in word 0 and either
'VALID ' or 'NOGOOD' in word 1.  Read VALID.FAI[1,BH] for further
details; it's a simple test program I wrote to check out the
feature.
⊗

TITLE MAISER
SUBTTL Definitions

; Mark Crispin, SU-AI, July '79
; Dialnet MAIL server

; Assembly switches

IFNDEF DLIBSZ,DLIBSZ==10000.	; ridiculously huge DLN input buffer size

; AC definitions

A=1 ? B=2 ? C=3 ? D=4 ? X=5 ? Y=6

; I/O channels

DSK==1

; System definitions

INTCLK==000200,,		; clock interrupts
INTIMS==000020,,		; DLN status change
INTINP==000010,,		; DLN input
IO%CLS==000200			; connection closing
IO%EOF==000400			; end of file

; Macros

DEFINE FATAL TEXT
 JRST [	OUTSTR [ASCIZ\!TEXT
\]
	JRST 4,.-1]
TERMIN

DEFINE SNDMSG TEXT
 DMOVE A,[440700,,[ASCIZ\!TEXT!\]
	  .LENGTH\!TEXT!\]
 SETZ C,
 OUTPUT A
 MTAPE [5]
TERMIN
;CORBEG CMDPNT RPCBLK WINDOW DLIBUF OBUF MAICHN COREND

SUBTTL Data area

CORBEG==.			; first loc zeroed at init time

CMDPNT:	BLOCK 1			; pointer for command string

RPCBLK:	0			; RPC command block
	BLOCK 2			; no PID
WINDOW:	BLOCK 1			; window size
	BLOCK 1			; no phone number

DLIBUF:	BLOCK DLIBSZ/4		; DLN input buffer

;  Don't break up OBUF and MAICHN!  Due to magic kludgery known only to the
; sorcerers of the deep, etc. etc...  If you figure out what's going on here,
; I'll buy you a beer.
OBUF:	BLOCK 3			; disk output buffer
MAICHN:	BLOCK 1			; mail channel

COREND==.-1
;MAISER

SUBTTL Start of program

;  Initialization.  We assume that if our PPN is [NET,SYS], then we were
; created by DLNLGR and the device name of the port which has the RPC
; pending was stashed in AC 17 by DLNLGR.  Otherwise we hazard a guess at
; DLN2, assuming it's a wizard debugging...

MAISER:	CAI
	RESET			; flush all I/O
	MOVE B,17		; DLNLGR passes device name in AC 17
	GETPPN A,
	CAME A,['NETSYS]
	 MOVE B,[SIXBIT/DLN2/]

; Now accept the connection

	MOVEI A,417		; dump mode
	SETZ C,			; no buffers
	OPEN A			; seize the port
	 FATAL Port OPEN failed
	SETSTS 17		; clear no-wait bit
	MOVEI A,5		; system maximum buffer size
	MOVEM A,WINDOW
	MTAPE RPCBLK		; accept the RPC
	 FATAL Accept RPC failed
	MTAPE [7]		; wait for connection
	 FATAL Connection wait failed

; Set up interrupts

	MOVEI [DISMIS]		; set up interrupt server
	MOVEM JOBAPR
	CLKINT 5*60.		; take a look-see every 5 seconds
	MOVSI (INTIMS\INTINP\INTCLK)
	INTENB			; enable interrupts

; Send greeting message

	SNDMSG [(Stanford University Artificial Intelligence Laboratory
MAIL server version 1.0
Bugs/gripes to Mark Crispin)]
;	JRST GETCMD
;GETCMD LOOP PRESC0 PRES1A PRESC1 PRESC2

SUBTTL Command read in

;  It is conceeded that this code is overly tolerant of lossage.  For example,
; it ignores garbage outside of the command, and if two commands are given
; without waiting for a reply it probably will just ignore the second command
; instead of barfing.
;  Later on this should be made both less tolerant and more robust.

GETCMD:	DMOVE A,[441140,,DLIBUF ? DLIBSZ]
	SETZ C,
LOOP:	IWAIT			; wait for an interrupt to happen
	INPUT A			; slurp up as much as possible on channel 0
	JUMPN C,[INPUT A	; flush non-zero channel data
		 JRST GETCMD]

;  Pre-scan command for parenthesis balancing.  If parenthesis balancing has
; happened, command is done and should be run.

	DMOVE X,[441100,,DLIBUF ? DLIBSZ]
	SUBI Y,(B)		; Y ← # of bytes read in
	JUMPE Y,LOOP		; none read in, sleep
	SETZ D,			; init parenthesis count
PRESC0:	ILDB X			; find initial open parenthesis
	CAIN "(
	 JRST PRESC1		; got it!
	SOJG Y,PRESC0		; ignore characters outside parens for now
	JRST LOOP		; not yet, back to sleep

PRES1A:	ILDB X			; get next byte
PRESC1:	CAIN "(			; open paren?
	 AOJA D,PRESC2		; yes, count another level
	CAIN ")			; close paren?
	 SOJE D,RUNCMD		; back out a level, maybe do it
	CAIE "/			; quoting?
	 JRST PRESC2		; no, charge on
	SOJE Y,LOOP		; yes, don't consider next character as a paren
	ILDB X
PRESC2:	SOJG Y,PRES1A		; more characters to do
	JRST LOOP		; end of what's been read in so far
;RUNCMD RUNCM1 RUNCM2 RUNCM3 BYECMD FLUSH

RUNCMD:	DMOVE A,[441100,,DLIBUF	; parse command for real now
		 440700,,C]	; command we get goes into C
;;	SETZ C,			; initialize command
RUNCM1:	ILDB A			; find the opening paren
	CAIE "(
	 JRST RUNCM1		; garbage or something
RUNCM2:	ILDB A			; read in command bytes
	CAIE ")			; end of command delimiter?
	 CAIN <" >		; (yes I know...)
	  JRST RUNCM3
	CAIL "a			; look like lowercase?
	 SUBI "a-"A		; convert to uppercase
	IDPB B			; looks like a command byte, stick it in
	TLNE B,770000		; filled up the word?
	 JRST RUNCM2		; not yet
RUNCM3:	CAMN C,[ASCII/MAIL/]	; send mail?
	 JRST MAICMD
	CAMN C,[ASCII/BYE/]	; suicide?
	 JRST BYECMD
	CAMN C,[ASCII/HELP/]	; I dunno
	 JRST [	SNDMSG [(OK (I am helpless))]
		JRST GETCMD]
	SNDMSG [(FAILED (No comprende))]
	JRST GETCMD

BYECMD:	SNDMSG [(OK (Cheers!))]
FLUSH:	MTAPE [1]		; close connection
	EXIT			; suicide
;MAICMD MAICM0 MAICM1

MAICMD:	MOVEM A,CMDPNT		; save command pointer
	CAIN ")			; null argument?
	 JRST MAINUL

; Decide upon a name for the mail request file

	INIT DSK,		; get a DSK DDB
	 'DSK,,
	 OBUF,,
	 FATAL DSK INIT failure
	ACCTIM A,
	DPB A,[061400,,A]	; shift RH 6 bits
	PJOB B,
	IORI A,(B)
MAICM0:	MOVSI B,'FTP
	SETZ C,
	MOVE D,['RMDSYS]
	LOOKUP DSK,A
	 JRST MAICM1
	CLOSE DSK,
	SUBI A,100		; go back a frob
	JRST MAICM0

; Create mail request file.

MAICM1:	MOVSI B,'FTP
	SETZ C,
	MOVE D,['RMDSYS]
	ENTER DSK,A
	 JRST [	RELEAS DSK,
		HRRZS B
		CAIN B,3	; oh fuck this isn't supposed to happen
		 JRST MAICMD
		CAIN B,12
		 JRST [	SNDMSG [(BUSY (DSK is full))]
			JRST GETCMD]
		SNDMSG [(FAILED (Scratch file failure))]
		JRST GETCMD]
	JSP A,MSGSTR
	 ASCIZ\MAIL/FROM"Dialnet" \
;	JRST MAICM2
;MAICM2 MAIDST MAIDS1 MAICM3 MAINUL

;  Copy address list to mail request file.  Be moderately paranoid.  Actually
; it should be a lot more fussy but for now its alright.

MAICM2:	ILDB C,CMDPNT		; scan for first address
	CAIN C,")		; end of command?
	 JRST MAINUL		; you turkey!
	CAIE C,"(
	 JRST MAICM2
MAIDST:	ILDB C,CMDPNT		; get first byte this address
	CAIN C,<" >		; flush spaces
	 JRST MAIDST
	CAIN C,")		; end of address?
	 JRST MAINUL		; don't fool me with a null address!
MAIDS1:	JSR MSGCHR		; looks good, stash it in file
	ILDB C,CMDPNT		; copy remainder of this address
	CAIE C,")		; boy is this guy trusting!
	 JRST MAIDS1
MAICM3:	ILDB C,CMDPNT		; get next address or start it
	CAIN C,")		; run command?
	 JRST MAILOK
	CAIE C,"(		; another address coming?
	 JRST MAICM3		; no, flush it as randomness
	MOVEI C,",		; another address coming, stash in a comma
	JSR MSGCHR
	JRST MAIDST		; continue copy

MAINUL:	RELEASE DSK,1		; flush request file if any
	SNDMSG [(FAILED (Null recepient illegal))]
	JRST GETCMD
;MAILOK MAILRD MSGSTR MSGCHR ..LIT

MAILOK:	MOVEI C,15		; CR
	JSR MSGCHR
	MOVEI C,12		; LF
	JSR MSGCHR
	MOVEI C,14		; formfeed
	JSR MSGCHR
	SNDMSG [(OK (What's shaking?))]
	SETSTS 17		; clear all status bits

;  Boy did I ever have fun writing this routine.  I hope you have as much fun
; reading it.

MAILRD:	MOVEI 1			; set up to read in channel (do it each time in
	MOVEM MAICHN		; case channel changed, etc)
	INPUT OBUF+1		; read in a buffer
	MOVE C,MAICHN		; "I see no maedchen here" - 7/24/79
	CAIE C,1		; is loser sending on non-1 channel?
	 JRST [	DMOVE A,[441140,,DLIBUF ? DLIBSZ]
		INPUT A		; yes, soak up the mumble into garbage
		STATZ IO%EOF	; EOF reached?
		 JRST MAILR1
		JRST MAILRD]
	STATO IO%EOF		; EOF reached?
	 JRST [	OUT DSK,
		 JRST MAILRD
		RELEASE DSK,1	; flush request file if any
		SNDMSG [(FAILED (Scratch file write failure))]
		JRST GETCMD]
MAILR1:	SNDMSG [(DONE (Thanks for the blurb))]
	CLOSE DSK,
	RELEAS DSK,
	MOVEI [SIXBIT/<RMND>RMDSYS/ ? 0]
	WAKEME			; start up mailer daemon
	 CAI
	JRST GETCMD

; Output string to message file from inline code

MSGSTR:	HRLI A,440700		; form byte pointer
	ILDB C,A
	JUMPE C,1(A)
	JSR MSGCHR
	JRST MSGSTR+1

; Output character in C to message file

MSGCHR:	0
	SOSG OBUF+2
	 OUT DSK,
	  CAIA
	   JRST [RELEAS DSK,1
		 SNDMSG [(FAILED (Scratch file write failure))]
		 JRST GETCMD]
	IDPB C,OBUF+1
	JRST 2,@MSGCHR

..LIT:	CONSTA

END MAISER